COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00006 ENDMK
C⊗;
BEGIN
COMMENT THIS PROGRAM IS USED TO DELETE .REL FILES ON [PNT,HE]
	WHICH MAY NOT BE OTHERWISE DELETED FOR A RECOMPILATION
	IT MAKES USE OF THE DATA FILE DELETE.DAT WHICH SHOULD BE
	EDITED WITH /N SWITCH;
INTEGER DATCHAN;
INTEGER DBRCHAR,DEOF,DFLAG;

INTEGER SRCCHAN,RELCHAN;
INTEGER SBRCHAR,SEOF,SFLAG,RBRCHAR,REOF,RFLAG;

INTEGER BRCHAR;
INTEGER NULBR,WORDENDBR,WORDBEGBR;

STRING INPUTSTRING,RFILE,SFILE,RFILE0;
STRING REXT,SEXT;

INTEGER RDATE,SDATE,RTIME,STIME;
PROCEDURE GETINFO(REFERENCE INTEGER DATE,TIME; REFERENCE STRING EXT);
	BEGIN
	INTEGER ARRAY INFOARRAY[1:6];
	FILEINFO(INFOARRAY);
	DATE←((INFOARRAY[2] LAND '700000)LSH -3 )+ INFOARRAY[3] LAND '7777;
	TIME←(INFOARRAY[3] LSH -12)LAND '3777;
	EXT←CV6STR(INFOARRAY[2] LAND ('777777 LSH 18))[1 TO 3];
	END;

REQUIRE "[][]" DELIMITERS;
DEFINE ! = [COMMENT],
	FF =['14],
	CR =['15],
	LF =['12],
	CRLF = [('15&'12)],
	SP =['40],
	TB =['11];

! now look for DELETE.DAT[PNT,HE] ;

OUTSTR(CRLF&"EXECUTING DELETE.DMP[PNT,HE]...."&CRLF);

OPEN(DATCHAN←GETCHAN,"DSK",0,2,0,200,DBRCHAR,DEOF);
LOOKUP(DATCHAN,"DELETE.DAT[PNT,HE]",DFLAG);
IF DFLAG THEN OUTSTR(CRLF&"COULDN'T LOOKUP FILE DELETE.DAT[PNT,HE]"&CRLF);


SETBREAK(NULBR←GETBREAK,FF,NULL,"INKS");
SETBREAK(WORDBEGBR←GETBREAK,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",SP&TB&LF,"INR");
SETBREAK(WORDENDBR←GETBREAK,SP&TB&CR,LF,"INS");


OPEN(SRCCHAN←GETCHAN,"DSK",0,2,0,200,SBRCHAR,SEOF);
OPEN(RELCHAN←GETCHAN,"DSK",0,2,0,200,RBRCHAR,REOF);
INPUTSTRING←NULL;
DO INPUTSTRING←INPUTSTRING&INPUT(DATCHAN,NULBR) UNTIL DEOF;
RFILE0←"XXXXXXX";
DO BEGIN
	LABEL DONE;
	SCAN(INPUTSTRING,WORDBEGBR,BRCHAR);
	RFILE←SCAN(INPUTSTRING,WORDENDBR,BRCHAR);
	IF BRCHAR≠TB THEN 
		BEGIN OUTSTR(CRLF&"Need tab after "&rfile&crlf&" TYPE CR TO CONTINUE");
			INCHWL;
		END;
	SCAN(INPUTSTRING,WORDBEGBR,BRCHAR);
	SFILE←SCAN(INPUTSTRING,WORDENDBR,BRCHAR);
	IF BRCHAR≠CR THEN
		BEGIN OUTSTR(CRLF&"Need <RETURN> after "&rfile&crlf&" TYPE CR TO CONTINUE");
			INCHWL;
		END;

	IF NOT EQU(RFILE,RFILE0) THEN
		BEGIN
		RFILE0←RFILE;
		LOOKUP(RELCHAN,RFILE,RFLAG);
		IF RFLAG THEN GOTO DONE;
		GETINFO(RDATE,RTIME,REXT);
		END;
	LOOKUP(SRCCHAN,SFILE,SFLAG);
	GETINFO(SDATE,STIME,SEXT);
	IF (SDATE>RDATE OR (SDATE=RDATE AND STIME≥RTIME)) AND EQU(REXT,"REL")
		THEN RENAME(RELCHAN,NULL,0,RFLAG);


DONE:	END UNTIL LENGTH(INPUTSTRING)≤2;

END;